114

Beginner’s Guide to Code Algorithms

114

STEP 3 & 4—​draw arrow function continued 3

        Set rng =​ Range(Cells(LabelRow, LabelCol), Cells(LabelRow +​ 2,

LabelCol +​ 1))

        With rng

        Set MyRct =​ ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal,

.Left, .Top, .Width, .Height)

        MyRct.Name =​ Sheets(CurrentSheetName).Cells(i, 1).Value & “-​1”

        MyRct.TextFrame2.TextRange.Characters.Text =​ i & “.” &

Sheets(CurrentSheetName).Cells(i, 3).Value

        MyRct.TextFrame2.TextRange.Characters.Font.Size =​ 6

        MyRct.TextFrame2.VerticalAnchor =​ msoAnchorBottom

        MyRct.TextFrame2.TextRange.ParagraphFormat.Alignment =​ msoAlignLeft

        MyRct.TextFrame2.TextRange.Characters.Font.Fill.ForeColor.

RGB =​ RGB(255, 0, 0)

        MyRct.TextFrame2.AutoSize =​ msoAutoSizeShapeToFitText

      End With

    End If

  End If

  If FoundPair =​ 0 Then

    Pair(i) =​ Sheets(CurrentSheetName).Cells(i, 1).Value &

Sheets(CurrentSheetName).Cells(i, 2).Value

  Else

    j =​ Worksheets(“IdenticalPairs”).Cells(Rows.Count, 1).End(xlUp).Row +​ 1

    Worksheets(“IdenticalPairs”).Cells(j, 1).Value =​ Sheets(CurrentSheetName).

Cells(i, 1).Value

    Worksheets(“IdenticalPairs”).Cells(j, 2).Value =​ Sheets(CurrentSheetName).

Cells(i, 2).Value

    Worksheets(“IdenticalPairs”).Cells(j, 3).Value =​ Sheets(CurrentSheetName).

Cells(i, 3).Value

    LabelToHighlight =​ Sheets(CurrentSheetName).Cells(FoundPair, 1).Value & “-​1”

    On Error Resume Next

    ActiveSheet.Shapes.Range(Array(LabelToHighlight)).Select

    On Error Resume Next

    Selection.ShapeRange(1).Fill.ForeColor.RGB =​ RGB(255, 255, 0) ‘yellow

highlight

    LabelToHighlight =​ Sheets(CurrentSheetName).Cells(FoundPair, 1).Value & “-​2”

    On Error Resume Next

    ActiveSheet.Shapes.Range(Array(LabelToHighlight)).Select

    On Error Resume Next

    Selection.ShapeRange(1).Fill.ForeColor.RGB =​ RGB(255, 255, 0) ‘yellow

highlight

  End If

  End Sub

Sub DrawRectangle(ByVal i As Integer, ByVal j As Integer, ByVal m As Integer, ByVal

n As Integer, ByVal Label, ByVal RowNum As Integer, ByVal BeginOrEnd As String)

  Dim rng As Range, MyRct As Shape

  If (BeginOrEnd =​ “Begin” And OldShapeBegin) Or (BeginOrEnd =​ “End” And

OldShapeEnd) Then

    Set rng =​ Range(Cells(i, j), Cells(m, n))

    With rng